home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 4 / Apprentice-Release4.iso / Languages / MacGofer 0.22d / MacGofer Sources / storage.c < prev    next >
Encoding:
Text File  |  1994-01-06  |  43.2 KB  |  1,335 lines  |  [TEXT/MPS ]
  1. /* --------------------------------------------------------------------------
  2.  * storage.c:   Copyright (c) Mark P Jones 1991-1993.   All rights reserved.
  3.  *              See goferite.h for details and conditions of use etc...
  4.  *              Gofer version 2.28 January 1993
  5.  *
  6.  *        Fixed to use dynamically configurable memory settings.
  7.  *        KH (17/5/92)
  8.  *
  9.  * Primitives for manipulating global data structures
  10.  * ------------------------------------------------------------------------*/
  11.  
  12. #include "prelude.h"
  13. #include "storage.h"
  14. #include "connect.h"
  15. #include "errors.h"
  16. #include <setjmp.h>
  17.  
  18. #if MPW
  19. #pragma segment Storage
  20. #endif
  21.  
  22. #if MAC
  23. extern Boolean MemoryInstalledOK;
  24. #endif
  25.  
  26. static List local insertName        Args((Name,List));
  27. static Void local patternError        Args((String));
  28. static Bool local stringMatch        Args((String,String));
  29.  
  30. static Int  local hash            Args((String));
  31. static Int  local saveText        Args((Text));
  32. static Cell local markCell        Args((Cell));
  33. static Void local markSnd        Args((Cell));
  34. static Cell local indirectChain        Args((Cell));
  35. static Void local garbageCollect    Args((Void));
  36. static Cell local lowLevelLastIn    Args((Cell));
  37. static Cell local lowLevelLastOut    Args((Cell));
  38. static Void local closeFile        Args((Int));
  39. #if DYNAMIC_STORAGE
  40.        Void local Dynamic_Storage_Init    Args((Void));
  41. #endif
  42.  
  43. /* --------------------------------------------------------------------------
  44.  * Text storage:
  45.  *
  46.  * provides storage for the characters making up identifier and symbol
  47.  * names, string literals, character constants etc...
  48.  *
  49.  * All character strings are stored in a large character array, with textHw
  50.  * pointing to the next free position.    Lookup in the array is improved using
  51.  * a hash table.  Internally, text strings are represented by integer offsets
  52.  * from the beginning of the array to the string in question.
  53.  *
  54.  * Where memory permits, the use of multiple hashtables gives a significant
  55.  * increase in performance, particularly when large source files are used.
  56.  *
  57.  * Each string in the array is terminated by a zero byte. be any one of the following:
  58.  *    CFUN   constructor function
  59.  *    PRIM   primitive function
  60.  *    MFUN   member function in class
  61.  *    NIL    user defined (or machine generated) compiled function
  62.  *
  63.  * Names are indexed by Text values ... a very simple hash functions speeds
  64.  * access to the table of Names and Name entries with the same hash value
  65.  * are chained together, with the most recent entry at the front of the
  66.  * list.
  67.  * ------------------------------------------------------------------------*/
  68.  
  69. static    Name     nameHw;        /* next unused name           */
  70.  
  71. #if DYNAMIC_STORAGE
  72. #define nHash(x) ((x)%namehsz)        /* Name hash function :: Text->Int */
  73. static    Name     *nameHash;        /* Hash table storage           */
  74. struct    Name     *tabName;        /* Name table storage           */
  75. #else
  76. #define nHash(x) ((x)%NAMEHSZ)        /* Name hash function :: Text->Int */
  77. static    Name     nameHash[NAMEHSZ];    /* Hash table storage           */
  78. struct    Name     tabName[NUM_NAME];    /* Name table storage           */
  79. #endif
  80.  
  81. Name newName(t)                /* add new name to name table       */
  82. Text t; {
  83.     Int h = nHash(t);
  84.  
  85.     if (nameHw-NAMEMIN >= num_name) {
  86.     ERROR(0) "Name storage space exhausted"
  87.     EEND;
  88.     }
  89.     name(nameHw).text          = t;    /* clear new name record        */
  90.     name(nameHw).line          = 0;
  91.     name(nameHw).arity          = 0;
  92.     name(nameHw).number       = 0;
  93.     name(nameHw).defn          = NIL;
  94.     name(nameHw).type          = NIL;
  95.     name(nameHw).primDef      = 0;
  96.     name(nameHw).nextNameHash = nameHash[h];
  97.     nameHash[h]           = nameHw;
  98.  
  99.     return nameHw++;
  100. }
  101.  
  102. Name findName(t)            /* locate name in name table       */
  103. Text t; {
  104.     Name n = nameHash[nHash(t)];
  105.  
  106.     while (nonNull(n) && name(n).text!=t)
  107.     n = name(n).nextNameHash;
  108.     return n;
  109. }
  110.  
  111. Void addPrim(l,n,s,ty)            /* add primitive function value    */
  112. Int    l;
  113. Name   n;
  114. String s;
  115. Type   ty; {
  116.     Int  i;
  117.  
  118.     for (i=0; primitives[i].ref; ++i)
  119.         if (strcmp(s,primitives[i].ref)==0) {
  120.         name(n).line    = l;
  121.         name(n).arity   = primitives[i].arity;
  122.         name(n).number  = i;
  123.         name(n).defn    = NIL;
  124.         name(n).type    = ty;
  125.         name(n).primDef = primitives[i].imp;
  126.         return;
  127.     }
  128.     ERROR(l) "Unknown primitive reference \"%s\"", s
  129.     EEND;
  130. }
  131.  
  132. Name addPrimCfun(s,arity,no,type)    /* add primitive constructor func. */
  133. String s;
  134. Int    arity;
  135. Int    no;
  136. Cell   type; {
  137.     Name n        = newName(findText(s));
  138.     name(n).arity   = arity;
  139.     name(n).number  = no;
  140.     name(n).defn    = CFUN;
  141.     name(n).type    = type;
  142.     name(n).primDef = 0;
  143.     return n;
  144. }
  145.  
  146. static List local insertName(nm,ns)    /* insert name nm into sorted list */
  147. Name nm;                /* ns                   */
  148. List ns; {
  149.     Cell   prev = NIL;
  150.     Cell   curr = ns;
  151.     String s    = textToStr(name(nm).text);
  152.  
  153.     while (nonNull(curr) && strcmp(s,textToStr(name(hd(curr)).text))>=0) {
  154.     if (hd(curr)==nm)        /* just in case we get duplicates! */
  155.         return ns;
  156.     prev = curr;
  157.     curr = tl(curr);
  158.     }
  159.     if (nonNull(prev)) {
  160.     tl(prev) = cons(nm,curr);
  161.     return ns;
  162.     }
  163.     else
  164.     return cons(nm,curr);
  165. }
  166.  
  167. List addNamesMatching(pat,ns)        /* Add names matching pattern pat  */
  168. String pat;                /* to list of names ns           */
  169. List   ns; {                /* Null pattern matches every name */
  170.     Name nm;
  171.     for (nm=NAMEMIN; nm<nameHw; ++nm)
  172.     if (nonNull(name(nm).type) &&
  173.         (!pat || stringMatch(pat,textToStr(name(nm).text))))
  174.         ns = insertName(nm,ns);
  175.     return ns;
  176. }
  177.  
  178.  
  179. /*
  180.     Return a list of definitions for a given module.
  181. */
  182. #if MAC
  183.  
  184. static List moddefs;
  185.  
  186. int initmoddefns(module)
  187. short module;
  188. {
  189.   Name nm;
  190.   int count = 0;
  191.   
  192.   Module m = startNewModule();
  193.   moddefs = NIL;
  194.   for (nm = NAMEMIN; nm<nameHw; ++nm)
  195.     {
  196.      if (nonNull(name(nm).type) && moduleThisName(nm)==(Module)module)
  197.         {
  198.       moddefs = insertName(nm,moddefs);
  199.       ++count;
  200.         }
  201.     }
  202.   dropModulesFrom(m);
  203.   return(count);
  204. }
  205.  
  206. char *nextDefn()
  207. {
  208.   if(moddefs == NIL)
  209.     return((char *)NULL);
  210.   else
  211.     {
  212.       Name nm = hd(moddefs);
  213.       moddefs = tl(moddefs);
  214.       return(textToStr(name(nm).text));
  215.     }
  216. }
  217.  
  218. donemoddefns()
  219. {
  220.   moddefs = NIL;
  221. }
  222. #endif
  223.  
  224.  
  225. /* --------------------------------------------------------------------------
  226.  * A simple string matching routine
  227.  *     `*'    matches any sequence of zero or more characters
  228.  *     `?'    matches any single character exactly 
  229.  *     `@str' matches the string str exactly (ignoring any special chars)
  230.  *     `\c'   matches the character c only (ignoring special chars)
  231.  *     c      matches the character c only
  232.  * ------------------------------------------------------------------------*/
  233.  
  234. static Void local patternError(s)    /* report error in pattern       */
  235. String s; {
  236.     ERROR(0) "%s in pattern", s
  237.     EEND;
  238. }
  239.  
  240. static Bool local stringMatch(pat,str)    /* match string against pattern       */
  241. String pat;
  242. String str; {
  243.  
  244.     for (;;)
  245.     switch (*pat) {
  246.         case '\0' : return (*str=='\0');
  247.  
  248.         case '*'  : do {
  249.                 if (stringMatch(pat+1,str))
  250.                 return TRUE;
  251.             } while (*str++);
  252.             return FALSE;
  253.  
  254.             case '?'  : if (*str++=='\0')
  255.                 return FALSE;
  256.             pat++;
  257.             break;
  258.  
  259.             case '['  : {   Bool found = FALSE;
  260.                 while (*++pat!='\0' && *pat!=']')
  261.                 if (!found && ( pat[0] == *str  ||
  262.                            (pat[1] == '-'   &&
  263.                         pat[2] != ']'   &&
  264.                         pat[2] != '\0'  &&
  265.                         pat[0] <= *str  &&
  266.                         pat[2] >= *str)))
  267.                                                
  268.                     found = TRUE;
  269.                 if (*pat != ']')
  270.                 patternError("missing `]'");
  271.                 if (!found)
  272.                 return FALSE;
  273.                 pat++;
  274.                 str++;
  275.             }
  276.                         break;
  277.  
  278.         case '\\' : if (*++pat == '\0')
  279.                 patternError("extra trailing `\\'");
  280.             /*fallthru!*/
  281.         default   : if (*pat++ != *str++)
  282.                 return FALSE;
  283.             break;
  284.     }
  285. }
  286.  
  287. /* --------------------------------------------------------------------------
  288.  * Storage of type classes, instances etc...:
  289.  * ------------------------------------------------------------------------*/
  290.  
  291. static Class classHw;               /* next unused class           */
  292. static Inst  instHw;               /* next unused instance record       */
  293. static Idx   idxHw;               /* next unused index tree record    */
  294. static Dict  dictHw;               /* next unused dictionary slot       */
  295.  
  296. #if DYNAMIC_STORAGE
  297. struct Class    *tabClass;           /* table of class records       */
  298. #else
  299. struct Class    tabClass[NUM_CLASSES]; /* table of class records       */
  300. #endif
  301.  
  302. struct Inst far *tabInst;           /* (pointer to) table of instances  */
  303. struct Idx  far *tabIndex;           /* (pointer to) table of indices    */
  304. Cell        far *tabDict;           /* (pointer to) table of dict slots */
  305.  
  306. Class newClass(t)               /* add new class to class table       */
  307. Text t; {
  308.     if (classHw-CLASSMIN >= num_classes) {
  309.     ERROR(0) "Class storage space exhausted"
  310.     EEND;
  311.     }
  312.     class(classHw).text      = t;
  313.     class(classHw).sig         = NIL;
  314.     class(classHw).head         = NIL;
  315.     class(classHw).supers    = NIL;
  316.     class(classHw).members   = NIL;
  317.     class(classHw).defaults  = NIL;
  318.     class(classHw).instances = NIL;
  319.     class(classHw).dictIndex = NOIDX;
  320.  
  321.     return classHw++;
  322. }
  323.  
  324. Class findClass(t)               /* look for named class in table    */
  325. Text t; {
  326.     Class c;
  327.  
  328.     for (c=CLASSMIN; c<classHw; c++)
  329.     if (class(c).text==t)
  330.         return c;
  331.     return NIL;
  332. }
  333.  
  334. Inst newInst() {               /* add new instance to table       */
  335.     if (instHw-INSTMIN >= num_insts) {
  336.     ERROR(0) "Instance storage space exhausted"
  337.     EEND;
  338.     }
  339.     inst(instHw).head         = NIL;
  340.     inst(instHw).specifics  = NIL;
  341.     inst(instHw).implements = NIL;
  342.  
  343.     return instHw++;
  344. }
  345.  
  346. Idx newIdx(test)               /* Add node to index tree, with       */
  347. Cell test; {                   /* specified test value            */
  348.     if (idxHw >= num_indexes) {
  349.     ERROR(0) "Index storage space exhausted"
  350.     EEND;
  351.     }
  352.     idx(idxHw).test  = test;
  353.     idx(idxHw).fail  = NOIDX;
  354.     idx(idxHw).match = NODICT;
  355.  
  356.     return idxHw++;
  357. }
  358.  
  359. Dict newDict(dictSize)               /* Allocate dictionary of given size*/
  360. Int dictSize; {
  361.     Dict dictStarts = dictHw;
  362.  
  363.     if ((dictHw+=dictSize) > num_dicts) {
  364.     ERROR(0) "Dictionary storage space exhausted"
  365.     EEND;
  366.     }
  367.     return dictStarts;
  368. }
  369.  
  370. /* --------------------------------------------------------------------------
  371.  * Control stack:
  372.  *
  373.  * Various parts of the system use a stack of cells.  Most of the stack
  374.  * operations are defined as macros, expanded inline.
  375.  * ------------------------------------------------------------------------*/
  376.  
  377. #if DYNAMIC_STORAGE
  378. Cell     *cellStack;                   /* Storage for cells on stack       */
  379. #else
  380. Cell     cellStack[NUM_STACK];           /* Storage for cells on stack       */
  381. #endif
  382.  
  383. #ifndef  GLOBALsp
  384. StackPtr sp;                   /* stack pointer            */
  385. #endif
  386.  
  387. Void stackOverflow() {               /* Report stack overflow        */
  388.     ERROR(0) "Control stack overflow"
  389.     EEND;
  390. }
  391.  
  392. /* --------------------------------------------------------------------------
  393.  * Module storage:
  394.  *
  395.  * script files are read into the system one after another.  The state of
  396.  * the stored data structures (except the garbage-collected heap) is recorded
  397.  * before reading a new script.  In the event of being unable to read the
  398.  * script, or if otherwise requested, the system can be restored to its
  399.  * original state immediately before the file was read.
  400.  * ------------------------------------------------------------------------*/
  401.  
  402. typedef struct {               /* record of storage state prior to */
  403.     Text  textHw;               /* reading script/module        */
  404.     Text  nextNewText;
  405.     Text  nextNewDText;
  406.     Int   syntaxHw;
  407.     Addr  addrHw;
  408.     Tycon tyconHw;
  409.     Name  nameHw;
  410.     Class classHw;
  411.     Inst  instHw;
  412.     Idx   idxHw;
  413.     Dict  dictHw;
  414. } module;
  415.  
  416. static Module moduleHw;            /* next unused module number       */
  417.  
  418. #if DYNAMIC_STORAGE
  419. static module *modules;    /* storage for module records       */
  420. #else
  421. static module modules[NUM_MODULES];    /* storage for module records       */
  422. #endif
  423.  
  424. Module startNewModule() {           /* start new module, keeping record */
  425.     if (moduleHw >= num_modules) {     /* of status for later restoration  */
  426.     ERROR(0) "Too many script/module files in use"
  427.     EEND;
  428.     }
  429.     modules[moduleHw].textHw       = textHw;
  430.     modules[moduleHw].nextNewText  = nextNewText;
  431.     modules[moduleHw].nextNewDText = nextNewDText;
  432.     modules[moduleHw].syntaxHw       = syntaxHw;
  433.     modules[moduleHw].addrHw       = addrHw;
  434.     modules[moduleHw].tyconHw       = tyconHw;
  435.     modules[moduleHw].nameHw       = nameHw;
  436.     modules[moduleHw].classHw       = classHw;
  437.     modules[moduleHw].instHw       = instHw;
  438.     modules[moduleHw].idxHw       = idxHw;
  439.     modules[moduleHw].dictHw       = dictHw;
  440.     return moduleHw++;
  441. }
  442.  
  443. Bool nameThisModule(n)            /* Test if given name is defined in*/
  444. Name n; {                /* current module           */
  445. #if MPW
  446.    return moduleHw<=1 || n>=modules[moduleHw-1].nameHw;
  447. #else
  448.    return moduleHw<1 || n>=modules[moduleHw-1].nameHw;
  449. #endif
  450. }
  451.  
  452. Module moduleThisName(nm)        /* find module number for name       */
  453. Name nm; {
  454.     Module m;
  455.  
  456.     for (m=0; m<moduleHw && nm>=modules[m].nameHw; m++)
  457.     ;
  458.     if (m>=moduleHw)
  459.     internal("moduleThisName");
  460.     return m;
  461. }
  462.  
  463. Void dropModulesFrom(mno)        /* Restore storage to state prior  */
  464. Module mno; {                /* to reading module mno        */
  465.     if (mno<moduleHw && mno >= 0) {    /* is there anything to restore?   */
  466.     int i;
  467.     textHw         = modules[mno].textHw;
  468.     nextNewText  = modules[mno].nextNewText;
  469.     nextNewDText = modules[mno].nextNewDText;
  470.     syntaxHw     = modules[mno].syntaxHw;
  471.     addrHw         = modules[mno].addrHw;
  472.     tyconHw      = modules[mno].tyconHw;
  473.     nameHw         = modules[mno].nameHw;
  474.     classHw      = modules[mno].classHw;
  475.     instHw         = modules[mno].instHw;
  476.     idxHw         = modules[mno].idxHw;
  477.     dictHw         = modules[mno].dictHw;
  478.  
  479.  
  480.     for (i=0; i<texthsz; ++i) {
  481.         int j = 0;
  482.         while (j<NUM_TEXTH && textHash[i][j]!=NOTEXT
  483.                    && textHash[i][j]<textHw)
  484.         ++j;
  485.         if (j<NUM_TEXTH)
  486.         textHash[i][j] = NOTEXT;
  487.     }
  488.  
  489.     for (i=0; i<tyconhsz; ++i) {
  490.         Tycon tc = tyconHash[i];
  491.         while (nonNull(tc) && tc>=tyconHw)
  492.         tc = tycon(tc).nextTyconHash;
  493.         tyconHash[i] = tc;
  494.     }
  495.  
  496.     for (i=0; i<namehsz; ++i) {
  497.         Name n = nameHash[i];
  498.         while (nonNull(n) && n>=nameHw)
  499.         n = name(n).nextNameHash;
  500.         nameHash[i] = n;
  501.     }
  502.  
  503.     for (i=CLASSMIN; i<classHw; i++) {
  504.         List in = class(i).instances;
  505.         List is = NIL;
  506.  
  507.         if (class(i).dictIndex>=idxHw)
  508.         class(i).dictIndex = NOIDX;
  509.  
  510.         while (nonNull(in)) {
  511.         List temp = tl(in);
  512.         if (hd(in)<instHw) {
  513.             tl(in) = is;
  514.             is     = in;
  515.         }
  516.         in = temp;
  517.         }
  518.         class(i).instances = rev(is);
  519.     }
  520.  
  521.     for (i=0; i<idxHw; ++i)
  522.         if (idx(i).fail>=idxHw)
  523.         idx(i).fail = NOIDX;
  524.  
  525. #if MPW    /* Reinitialise predefined types and names for the Prelude -- KH */
  526.     if(mno == 0)
  527.       {
  528.         InitPredefTypes();
  529.         InitPredefNames();
  530.       }
  531. #endif
  532.  
  533.     moduleHw = mno;
  534.     }
  535. }
  536.  
  537. /* --------------------------------------------------------------------------
  538.  * Heap storage:
  539.  * Provides a garbage collectable heap for storage of expressions etc.
  540.  * ------------------------------------------------------------------------*/
  541.  
  542. Int     heapSize = DEFAULTHEAP;        /* number of cells in heap       */
  543. Heap    heapCar;            /* array of fst component of pairs */
  544. Heap    heapCdr;            /* array of snd component of pairs */
  545. #ifndef GLOBALcar
  546. Heap    heapTopCar;
  547. #endif
  548. #ifndef GLOBALcdr
  549. Heap    heapTopCdr;
  550. #endif
  551. Long    numCells;
  552. Int     numberGcs;            /* number of garbage collections   */
  553.  
  554. static  Cell freeList;            /* free list of unused cells       */
  555.  
  556. Cell pair(l,r)                /* Allocate pair (l, r) from       */
  557. Cell l, r; {                /* heap, garbage collecting first  */
  558.     Cell c = freeList;            /* if necessary ...           */
  559.  
  560.     if (isNull(c)) {
  561.     garbageCollect();
  562.     c = freeList;
  563.     }
  564.     freeList = snd(freeList);
  565.     fst(c)   = l;
  566.     snd(c)   = r;
  567.     numCells++;
  568.     return c;
  569. }
  570.  
  571. Void overwrite(dst,src)            /* overwrite dst cell with src cell*/
  572. Cell dst, src; {            /* both *MUST* be pairs            */
  573.     if (isPair(dst) && isPair(src)) {
  574.         fst(dst) = fst(src);
  575.         snd(dst) = snd(src);
  576.     }
  577.     else
  578.         internal("overwrite");
  579. }
  580.  
  581. static Int *marks;
  582. static Int marksSize;
  583.  
  584. Cell markExpr(c)            /* External interface to markCell  */
  585. Cell c; {
  586.     return markCell(c);
  587. }
  588.  
  589. static Cell local markCell(c)        /* Traverse part of graph marking  */
  590. Cell c; {                /* cells reachable from given root */
  591.  
  592. mc: if (!isPair(c))
  593.     return c;
  594.  
  595.     if (fst(c)==INDIRECT) {
  596.     c = indirectChain(c);
  597.     goto mc;
  598.     }
  599.  
  600.     {   register place = placeInSet(c);
  601.     register mask  = maskInSet(c);
  602.     if (marks[place]&mask)
  603.         return c;
  604.     else
  605.         marks[place] |= mask;
  606.     }
  607.  
  608.     if (isPair(fst(c))) {
  609.         /* Avoid stack overflows during recursive marking -- KH */
  610.         STACK_CHECK;
  611.     fst(c) = markCell(fst(c));
  612.     markSnd(c);
  613.     }
  614.     else if (isNull(fst(c)) || fst(c)>=BCSTAG) {
  615.         /* Avoid stack overflows during recursive marking -- KH */
  616.         STACK_CHECK;
  617.     markSnd(c);
  618.     }
  619.  
  620.     return c;
  621. }
  622.  
  623. static Void local markSnd(c)        /* Variant of markCell used to     */
  624. Cell c; {                /* update snd component of cell    */
  625.     Cell t;                /* using tail recursion           */
  626.  
  627. ma: t = snd(c);
  628. mb: if (!isPair(t))
  629.     return;
  630.  
  631.     if (fst(t)==INDIRECT) {
  632.     snd(c) = t = indirectChain(t);
  633.     goto mb;
  634.     }
  635.     c = snd(c) = t;
  636.  
  637.     {   register place = placeInSet(c);
  638.     register mask  = maskInSet(c);
  639.     if (marks[place]&mask)
  640.         return;
  641.     else
  642.         marks[place] |= mask;
  643.     }
  644.  
  645.     if (isPair(fst(c))) {
  646.     fst(c) = markCell(fst(c));
  647.     goto ma;
  648.     }
  649.     else if (isNull(fst(c)) || fst(c)>=BCSTAG)
  650.     goto ma;
  651.     return;
  652. }
  653.  
  654. static Cell local indirectChain(c)    /* Scan chain of indirections       */
  655. Cell c; {                /* Detecting loops of indirections */
  656.     Cell is = c;            /* Uses pointer reversal ...       */
  657.     c       = snd(is);
  658.     snd(is) = NIL;
  659.     fst(is) = INDIRECT1;
  660.  
  661.     while (isPair(c) && fst(c)==INDIRECT) {
  662.     register Cell temp = snd(c);
  663.     snd(c)  = is;
  664.     is      = c;
  665.     c       = temp;
  666.     fst(is) = INDIRECT1;
  667.     }
  668.  
  669.     if (isPair(c) && fst(c)==INDIRECT1)
  670.     c = nameBlackHole;
  671.  
  672.     do {
  673.     register Cell temp = snd(is);
  674.     fst(is) = INDIRECT;
  675.     snd(is) = c;
  676.     is    = temp;
  677.     } while (nonNull(is));
  678.  
  679.     return c;
  680. }
  681.  
  682. #if MPW
  683. #pragma segment Storage2
  684. #endif
  685.  
  686. Void markWithoutMove(n)            /* Garbage collect cell at n, as if*/
  687. Cell n; {                /* it was a cell ref, but don't    */
  688.                     /* move cell (i.e. retain INDIRECT */
  689.                     /* at top level) so we don't have  */
  690.                     /* to modify the stored value of n */
  691.     if (isGenPair(n)) {
  692.     if (fst(n)==INDIRECT) {        /* special case for indirections   */
  693.         register place = placeInSet(n);
  694.         register mask  = maskInSet(n);
  695.         marks[place]  |= mask;
  696.         markSnd(n);
  697.     }
  698.     else
  699.         markCell(n);        /* normal pairs don't move anyway  */
  700.     }
  701. }
  702.  
  703. #if MAC
  704. extern Bool HandlingEvents;
  705. #endif
  706.  
  707. static Void local garbageCollect() {    /* Run garbage collector ...       */
  708.     Bool breakStat = breakOn(FALSE);    /* disable break checking       */
  709.     Int i,j;
  710.     register Int mask;
  711.     register Int place;
  712.     Int      recovered;
  713.     jmp_buf  regs;            /* save registers on stack       */
  714.     setjmp(regs);
  715.  
  716.  
  717. #if MAC
  718.     if(!HandlingEvents)
  719.       SetGCCursor(TRUE);
  720. #endif
  721.  
  722.     gcStarted();
  723.     for (i=0; i<marksSize; ++i)        /* initialise mark set to empty    */
  724.     marks[i] = 0;
  725.     everybody(MARK);            /* mark all components of system   */
  726.  
  727.     /* Just in case garbageCollect is triggered when free list is non-empty*/
  728.     /* (called by openFile for example), scan the free list and unmark all */
  729.     /* cells - which otherwise might have been marked from the Cstack      */
  730.     for (; nonNull(freeList); freeList=snd(freeList))
  731.     marks[placeInSet(freeList)] &= ~(maskInSet(freeList));
  732.  
  733.     gcScanning();            /* scan mark set           */
  734.     mask      = 1;
  735.     place     = 0;
  736.     recovered = 0;
  737.     j         = 0;
  738.     for (i=1; i<=heapSize; i++) {
  739.     if ((marks[place] & mask) == 0) {
  740.         if (fst(-i)==FILECELL) {
  741.         closeFile(intValOf(-i));
  742.         fst(-i) = INTCELL;
  743.         }
  744.         snd(-i)  = freeList;
  745.         freeList = -i;
  746.         recovered++;
  747.     }
  748.     mask <<= 1;
  749.     if (++j == bitsPerWord) {
  750.         place++;
  751.         mask = 1;
  752.         j    = 0;
  753.     }
  754.     }
  755.     gcRecovered(recovered);
  756.  
  757. #if MAC
  758.     if(!HandlingEvents)
  759.       SetGCCursor(FALSE);
  760. #endif
  761.  
  762.     breakOn(breakStat);            /* restore break trapping if nec.  */
  763.  
  764.     /* can only return if freeList is nonempty on return. */
  765.     if (recovered<minRecovery || isNull(freeList)) {
  766.     ERROR(0) "Garbage collection fails to reclaim sufficient space"
  767.     EEND;
  768.     }
  769.     numberGcs++;
  770. }
  771.  
  772. /* --------------------------------------------------------------------------
  773.  * Code for saving last expression entered:
  774.  *
  775.  * This is a little tricky since some text values (e.g. strings or variable
  776.  * names) may not be defined or have the same value when the expression is
  777.  * recalled.  These text values are therefore saved in the top portion of
  778.  * the text table.
  779.  * ------------------------------------------------------------------------*/
  780.  
  781. static Cell lastExprSaved;        /* last expression to be saved       */
  782.  
  783. Void setLastExpr(e)            /* save expression for later recall*/
  784. Cell e; {
  785.     lastExprSaved = NIL;        /* in case attempt to save fails   */
  786.     savedText      = num_text;
  787.     lastExprSaved = lowLevelLastIn(e);
  788. }
  789.  
  790. static Cell local lowLevelLastIn(c)    /* Duplicate expression tree (i.e. */
  791. Cell c; {                /* acyclic graph) for later recall */
  792.     if (isPair(c))            /* Duplicating any text strings    */
  793.     if (isBoxTag(fst(c)))        /* in case these are lost at some  */
  794.         switch (fst(c)) {        /* point before the expr is reused */
  795.         case VARIDCELL :
  796.         case VAROPCELL :
  797.         case DICTVAR   :
  798.         case CONIDCELL :
  799.         case CONOPCELL :
  800.         case STRCELL   : return pair(fst(c),saveText(textOf(c)));
  801.         default           : return pair(fst(c),snd(c));
  802.         }
  803.     else
  804.         return pair(lowLevelLastIn(fst(c)),lowLevelLastIn(snd(c)));
  805.     else
  806.     return c;
  807. }
  808.  
  809. Cell getLastExpr() {            /* recover previously saved expr   */
  810.     return lowLevelLastOut(lastExprSaved);
  811. }
  812.  
  813. static Cell local lowLevelLastOut(c)    /* As with lowLevelLastIn() above  */
  814. Cell c; {                /* except that Cells refering to   */
  815.     if (isPair(c))            /* Text values are restored to       */
  816.     if (isBoxTag(fst(c)))        /* appropriate values           */
  817.         switch (fst(c)) {
  818.         case VARIDCELL :
  819.         case VAROPCELL :
  820.         case DICTVAR   :
  821.         case CONIDCELL :
  822.         case CONOPCELL :
  823.         case STRCELL   : return pair(fst(c),
  824.                          findText(text+intValOf(c)));
  825.         default           : return pair(fst(c),snd(c));
  826.         }
  827.     else
  828.         return pair(lowLevelLastOut(fst(c)),lowLevelLastOut(snd(c)));
  829.     else
  830.     return c;
  831. }
  832.  
  833. /* --------------------------------------------------------------------------
  834.  * Miscellaneous operations on heap cells:
  835.  * ------------------------------------------------------------------------*/
  836.  
  837. /* profiling suggests that the number of calls to whatIs() is typically    */
  838. /* rather high.  The recoded version below attempts to improve the average */
  839. /* performance for whatIs() using a binary search for part of the analysis */
  840.  
  841. Cell whatIs(c)                   /* identify type of cell        */
  842. register Cell c; {
  843.     if (isPair(c)) {
  844.     register Cell fstc = fst(c);
  845.     return isTag(fstc) ? fstc : AP;
  846.     }
  847.     if (c<TUPMIN)    return c;
  848.     if (c>=INTMIN)   return INTCELL;
  849.  
  850.     if (c>=SELMIN)  if (c>=CLASSMIN)    if (c>=CHARMIN) return CHARCELL;
  851.                     else        return CLASS;
  852.             else        if (c>=INSTMIN) return INSTANCE;
  853.                     else        return SELECT;
  854.     else        if (c>=TYCMIN)    if (c>=NAMEMIN)    return NAME;
  855.                     else        return TYCON;
  856.             else        if (c>=OFFMIN)    return OFFSET;
  857.                     else        return TUPLE;
  858.  
  859. /*  if (c>=CHARMIN)  return CHARCELL;
  860.     if (c>=CLASSMIN) return CLASS;
  861.     if (c>=INSTMIN)  return INSTANCE;
  862.     if (c>=SELMIN)   return SELECT;
  863.     if (c>=NAMEMIN)  return NAME;
  864.     if (c>=TYCMIN)   return TYCON;
  865.     if (c>=OFFMIN)   return OFFSET;
  866.     if (c>=TUPMIN)   return TUPLE;
  867.     return c;*/
  868. }
  869.  
  870. Bool isVar(c)                /* is cell a VARIDCELL/VAROPCELL ? */
  871. Cell c; {                /* also recognises DICTVAR cells   */
  872.     return isPair(c) &&
  873.            (fst(c)==VARIDCELL || fst(c)==VAROPCELL || fst(c)==DICTVAR);
  874. }
  875.  
  876. Bool isCon(c)                   /* is cell a CONIDCELL/CONOPCELL ?  */
  877. Cell c; {
  878.     return isPair(c) && (fst(c)==CONIDCELL || fst(c)==CONOPCELL);
  879. }
  880.  
  881. Bool isInt(c)                   /* cell holds integer value?       */
  882. Cell c; {
  883.     return isSmall(c) || (isPair(c) && fst(c)==INTCELL);
  884. }
  885.  
  886. Int intOf(c)                   /* find integer value of cell?       */
  887. Cell c; {
  888.     return isPair(c) ? (Int)(snd(c)) : (Int)(c-INTZERO);
  889. }
  890.  
  891. Cell mkInt(n)                   /* make cell representing integer   */
  892. Int n; {
  893.     return isSmall(INTZERO+n) ? INTZERO+n : pair(INTCELL,n);
  894. }
  895.  
  896. /* --------------------------------------------------------------------------
  897.  * List operations:
  898.  * ------------------------------------------------------------------------*/
  899.  
  900. Int length(xs)                   /* calculate length of list xs       */
  901. List xs; {
  902.     Int n = 0;
  903.     for (n=0; nonNull(xs); ++n)
  904.     xs = tl(xs);
  905.     return n;
  906. }
  907.  
  908. List appendOnto(xs,ys)               /* Destructively prepend xs onto    */
  909. List xs, ys; {                   /* ys by modifying xs ...       */
  910.     if (isNull(xs))
  911.     return ys;
  912.     else {
  913.     List zs = xs;
  914.     while (nonNull(tl(zs)))
  915.         zs = tl(zs);
  916.     tl(zs) = ys;
  917.     return xs;
  918.     }
  919. }
  920.  
  921. List revOnto(xs,ys)               /* Destructively reverse elements of*/
  922. List xs, ys; {                   /* list xs onto list ys...       */
  923.     Cell zs;
  924.  
  925.     while (nonNull(xs)) {
  926.     zs     = tl(xs);
  927.     tl(xs) = ys;
  928.     ys     = xs;
  929.     xs     = zs;
  930.     }
  931.     return ys;
  932. }
  933.  
  934. Cell varIsMember(t,xs)               /* Test if variable is a member of  */
  935. Text t;                    /* given list of variables       */
  936. List xs; {
  937.     for (; nonNull(xs); xs=tl(xs))
  938.     if (t==textOf(hd(xs)))
  939.         return hd(xs);
  940.     return NIL;
  941. }
  942.  
  943. Cell cellIsMember(x,xs)            /* Test for membership of specific  */
  944. Cell x;                    /* cell x in list xs           */
  945. List xs; {
  946.     for (; nonNull(xs); xs=tl(xs))
  947.     if (x==hd(xs))
  948.         return hd(xs);
  949.     return NIL;
  950. }
  951.  
  952. List copy(n,x)                   /* create list of n copies of x       */
  953. Int n;
  954. Cell x; {
  955.     List xs=NIL;
  956.     while (0<n--)
  957.     xs = cons(x,xs);
  958.     return xs;
  959. }
  960.  
  961. List diffList(from,take)           /* list difference: from\take       */
  962. List from, take; {               /* result contains all elements of  */
  963.     List result = NIL;               /* `from' not appearing in `take'   */
  964.  
  965.     while (nonNull(from)) {
  966.     List next = tl(from);
  967.     if (!cellIsMember(hd(from),take)) {
  968.         tl(from) = result;
  969.         result   = from;
  970.     }
  971.     from = next;
  972.     }
  973.     return rev(result);
  974. }
  975.  
  976. List take(n,xs)                /* destructively trancate list to  */
  977. Int  n;                    /* specified length           */
  978. List xs; {
  979.     List start = xs;
  980.  
  981.     if (n==0)
  982.     return NIL;
  983.     while (1<n-- && nonNull(xs))
  984.     xs = tl(xs);
  985.     if (nonNull(xs))
  986.     tl(xs) = NIL;
  987.     return start;
  988. }
  989.  
  990. List removeCell(x,xs)            /* destructively remove cell from  */
  991. Cell x;                    /* list                   */
  992. List xs; {
  993.     if (nonNull(xs)) {
  994.     if (hd(xs)==x)
  995.         return tl(xs);        /* element at front of list       */
  996.     else {
  997.         List prev = xs;
  998.         List curr = tl(xs);
  999.         for (; nonNull(curr); prev=curr, curr=tl(prev))
  1000.         if (hd(curr)==x) {
  1001.             tl(prev) = tl(curr);
  1002.             return xs;        /* element in middle of list       */
  1003.         }
  1004.     }
  1005.     }
  1006.     return xs;                /* here if element not found       */
  1007. }
  1008.  
  1009. /* --------------------------------------------------------------------------
  1010.  * Operations on applications:
  1011.  * ------------------------------------------------------------------------*/
  1012.  
  1013. Int argCount;                   /* number of args in application    */
  1014.  
  1015. Cell getHead(e)                /* get head cell of application       */
  1016. Cell e; {                   /* set number of args in argCount   */
  1017.     for (argCount=0; isAp(e); e=fun(e))
  1018.     argCount++;
  1019.     return e;
  1020. }
  1021.  
  1022. List getArgs(e)                /* get list of arguments in function*/
  1023. Cell e; {                   /* application:               */
  1024.     List as;                   /* getArgs(f e1 .. en) = [e1,..,en] */
  1025.  
  1026.     for (as=NIL; isAp(e); e=fun(e))
  1027.     as = cons(arg(e),as);
  1028.     return as;
  1029. }
  1030.  
  1031. Cell nthArg(n,e)               /* return nth arg in application    */
  1032. Int  n;                       /* of function to m args (m>=n)     */
  1033. Cell e; {                              /* nthArg n (f x0 x1 ... xm) = xn   */
  1034.     for (n=numArgs(e)-n-1; n>0; n--)
  1035.     e = fun(e);
  1036.     return arg(e);
  1037. }
  1038.  
  1039. Int numArgs(e)                   /* find number of arguments to expr */
  1040. Cell e; {
  1041.     Int n;
  1042.     for (n=0; isAp(e); e=fun(e))
  1043.     n++;
  1044.     return n;
  1045. }
  1046.  
  1047. Cell applyToArgs(f,args)           /* destructively apply list of args */
  1048. Cell f;                       /* to function f               */
  1049. List args; {
  1050.     while (nonNull(args)) {
  1051.     Cell temp = tl(args);
  1052.     tl(args)  = hd(args);
  1053.     hd(args)  = f;
  1054.     f      = args;
  1055.     args      = temp;
  1056.     }
  1057.     return f;
  1058. }
  1059.  
  1060. /* --------------------------------------------------------------------------
  1061.  * File operations:
  1062.  * ------------------------------------------------------------------------*/
  1063.  
  1064. #if DYNAMIC_STORAGE
  1065. static FILE **infiles;            /* file pointers for input files   */
  1066. #else
  1067. static FILE *infiles[NUM_FILES];    /* file pointers for input files   */
  1068. #endif
  1069.  
  1070. Cell openFile(s)            /* create FILECELL object for named*/
  1071. String s; {                /* input file               */
  1072.     Int i;
  1073.  
  1074.     for (i=0; i<num_files && infiles[i]; ++i)    /* look for unused file .. */
  1075.     ;
  1076.     if (i>=num_files) {                /* if at first we don't    */
  1077.     garbageCollect();            /* succeed, garbage collect*/
  1078.     for (i=0; i<num_files && infiles[i]; ++i)
  1079.         ;                    /* and try again ...       */
  1080.     }
  1081.     if (i>=num_files) {                /* ... before we give up   */
  1082.     ERROR(0) "Too many files open; cannot open %s", s
  1083.     EEND;
  1084.     }
  1085.  
  1086.     if (infiles[i]=fopen(s,"r"))
  1087.     return ap(FILECELL,i);
  1088.     else
  1089.     return NIL;
  1090. }
  1091.  
  1092. Void evalFile(f)                /* read char from given    */
  1093. Cell f; {                    /* input file -- ensure       */
  1094.     Int c;                    /* only 1 copy of FILECELL */
  1095.     if ((c = fgetc(infiles[intValOf(f)]))==EOF) {
  1096.     closeFile(intValOf(f));
  1097.     fst(f) = INDIRECT;
  1098.     snd(f) = nameNil;
  1099.     }
  1100.     else {
  1101.     snd(f) = ap(FILECELL,intValOf(f));
  1102.     fst(f) = NIL;    /* avoid having 2 copies of FILECELL, so that file */
  1103.             /* is not closed prematurely by garbage collector  */
  1104.     fst(f) = consChar(c);
  1105.     }
  1106. }
  1107.  
  1108. static Void local closeFile(n)            /* close input file n       */
  1109. Int n; {                    /* only permitted when the */
  1110.     if (0<=n && n<num_files && infiles[n]) {    /* end of file is read or  */
  1111.     fclose(infiles[n]);            /* when discarded during gc*/
  1112.     infiles[n] = 0;
  1113.     }
  1114. }
  1115.  
  1116. /* --------------------------------------------------------------------------
  1117.  * storage control:
  1118.  * ------------------------------------------------------------------------*/
  1119.  
  1120. #if MAC
  1121. #include <Memory.h>
  1122. #endif
  1123.  
  1124. Void storage(what)
  1125. Int what; {
  1126.     Int i;
  1127.  
  1128.     switch (what) {
  1129.     case RESET   : clearStack();
  1130.  
  1131.                /* the next 2 statements are particularly important
  1132.                 * if you are using GLOBALcar or GLOBALcdr since the
  1133.             * corresponding registers may be reset to their
  1134.             * uninitialised initial values by a longjump.
  1135.             */
  1136.                heapTopCar = heapCar + heapSize;
  1137.                heapTopCdr = heapCdr + heapSize;
  1138.  
  1139.                if (isNull(lastExprSaved))
  1140.                savedText = num_text;
  1141.                break;
  1142.  
  1143.     case MARK    : for (i=TYCMIN; i<tyconHw; ++i) {
  1144.                mark(tycon(i).defn);
  1145.                mark(tycon(i).kind);
  1146.                mark(tycon(i).what);
  1147.                }
  1148.  
  1149.                for (i=NAMEMIN; i<nameHw; ++i) {
  1150.                mark(name(i).defn);
  1151.                mark(name(i).type);
  1152.                }
  1153.  
  1154.                for (i=CLASSMIN; i<classHw; ++i) {
  1155.                mark(class(i).sig);
  1156.                mark(class(i).head);
  1157.                mark(class(i).supers);
  1158.                mark(class(i).members);
  1159.                mark(class(i).defaults);
  1160.                            mark(class(i).instances);
  1161.                }
  1162.  
  1163.                for (i=INSTMIN; i<instHw; ++i) {
  1164.                mark(inst(i).sig);
  1165.                mark(inst(i).head);
  1166.                mark(inst(i).specifics);
  1167.                mark(inst(i).implements);
  1168.                }
  1169.  
  1170.                for (i=0; i<=sp; ++i)
  1171.                mark(stack(i));
  1172.  
  1173.                        for (i=0; i<dictHw; ++i)
  1174.                            mark(dict(i));
  1175.  
  1176.                mark(lastExprSaved);
  1177.  
  1178.                        gcCStack();
  1179.  
  1180.                break;
  1181.  
  1182.     case INSTALL : clearStack();
  1183.  
  1184.                for (i=0; i<num_files; i++)
  1185.                infiles[i] = 0;
  1186.  
  1187.                textHw         = 0;
  1188.                nextNewText   = num_text;
  1189.                nextNewDText  = (-1);
  1190.                lastExprSaved = NIL;
  1191.                savedText     = num_text;
  1192.                for (i=0; i<texthsz; ++i)
  1193.                textHash[i][0] = NOTEXT;
  1194.  
  1195.                syntaxHw = 0;
  1196.  
  1197.                addrHw    = 0;
  1198.  
  1199.                tyconHw    = TYCMIN;
  1200.                for (i=0; i<tyconhsz; ++i)
  1201.                tyconHash[i] = NIL;
  1202.  
  1203.                nameHw = NAMEMIN;
  1204.                for (i=0; i<namehsz; ++i)
  1205.                nameHash[i] = NIL;
  1206.  
  1207.                classHw    = CLASSMIN;
  1208.  
  1209.                instHw    = INSTMIN;
  1210.  
  1211.                idxHw    = 0;
  1212.  
  1213.                dictHw    = 0;
  1214.  
  1215.                tabInst    = (struct Inst far *)
  1216.                     farCalloc(num_insts,sizeof(struct Inst));
  1217.                tabIndex = (struct Idx far *)
  1218.                     farCalloc(num_indexes,sizeof(struct Idx));
  1219.                tabDict    = (Cell far *)
  1220.                     farCalloc(num_dicts,sizeof(Cell));
  1221.  
  1222.                if (tabInst==0 || tabIndex==0 || tabDict==0) {
  1223.                ERROR(0) "Cannot allocate instance tables"
  1224.                EEND;
  1225.                }
  1226.  
  1227.                moduleHw = 0;
  1228.  
  1229.                /*
  1230.                   Heap allocation moved here so we can grab all the
  1231.                      remaining space on the Mac -- KH
  1232.                */
  1233.  
  1234. #if MAC
  1235.                /* 
  1236.                    HeapPC% of the remaining memory is used for 2 heaps.
  1237.                Allow for the later allocation of the address table.
  1238.                */
  1239.                {
  1240.                  Size dummy;
  1241.              extern int HeapPC;
  1242.                  heapSize = ((MaxMem(&dummy)-num_addrs*sizeof(Float))
  1243.                         * HeapPC/100) / sizeof(Cell) / 2;
  1244.                }
  1245. #endif
  1246.  
  1247.                heapCar = heapAlloc(heapSize);
  1248.                heapCdr = heapAlloc(heapSize);
  1249.  
  1250.                if (heapCar==(Heap)0 || heapCdr==(Heap)0) {
  1251.                ERROR(0) "Cannot allocate heap storage (%d cells)",
  1252.                     heapSize
  1253.                EEND;
  1254.                }
  1255.  
  1256.                heapTopCar = heapCar + heapSize;
  1257.                heapTopCdr = heapCdr + heapSize;
  1258.  
  1259.                for (i=1; i<heapSize; ++i)
  1260.                snd(-i) = -(i+1);
  1261.                snd(-heapSize) = NIL;
  1262.                freeList       = -1;
  1263.                numberGcs      = 0;
  1264.  
  1265.                marksSize  = bitArraySize(heapSize);
  1266.                if ((marks=(Int *)calloc(marksSize, sizeof(Int)))==0) {
  1267.                ERROR(0) "Unable to allocate gc markspace"
  1268.                EEND;
  1269.                }
  1270.                
  1271. #if MAC
  1272.                MemoryInstalledOK = TRUE;
  1273. #endif
  1274.                break;
  1275.     }
  1276. }
  1277.  
  1278.  
  1279. /*****************************************************************************
  1280.  
  1281.     Dynamic Storage Allocation.
  1282.     
  1283.     This code allocates the basic Gofer arrays dynamically rather than
  1284.     using fixed settings.  This is necessary on the Mac if you
  1285.     want > 32K buffers, but is desirable on other machines too since
  1286.     you no longer need to recompile Gofer just because NUM_TEXT is
  1287.     too small.  This should make it easier to use the same binary for
  1288.     both teaching and research, and reduce the occurrence of
  1289.     "private Gofer versions" -- KH
  1290.     
  1291.     Note: having been bitten by a non-initialised location elsewhere,
  1292.     I now use farCalloc rather than malloc.  The time penalty doesn't
  1293.     seem significant on the Mac.  The Unix version uses valloc rather
  1294.     than calloc.  This doesn't zero memory so be careful: 
  1295.     you may want to bzero the allocated areas.
  1296.  
  1297. *****************************************************************************/
  1298.  
  1299.  
  1300. #if DYNAMIC_STORAGE
  1301.  
  1302. extern Int  *offsPosn;
  1303. extern Addr *fixups;
  1304.  
  1305.  
  1306. Void local Dynamic_Storage_Init()
  1307. {
  1308.   int i;
  1309.   offsPosn =     (Int *)            farCalloc(num_offsets,  sizeof(Int));
  1310.   tabTycon =     (struct Tycon *)    farCalloc(num_tycon,    sizeof(struct Tycon));
  1311.   tyconHash =     (Tycon *)        farCalloc(tyconhsz,     sizeof(Tycon));
  1312.   tabSyntax =     (struct SyntaxTab *)    farCalloc(num_syntax,   sizeof(struct SyntaxTab));
  1313.   nameHash =     (Name *)        farCalloc(namehsz,      sizeof(Name));
  1314.   tabName =     (struct Name *)        farCalloc(num_name,     sizeof(struct Name));
  1315.   tabClass =     (struct Class *)     farCalloc(num_classes,  sizeof(struct Class));
  1316.   cellStack =     (Cell *)        farCalloc(num_stack,    sizeof(Cell));
  1317.   modules =     (module *)        farCalloc(num_modules,  sizeof(module));
  1318.   text =    (char *)        farCalloc(num_text,     sizeof(char));
  1319.   infiles =    (FILE **)        farCalloc(num_text,     sizeof(FILE *));
  1320.   fixups =     (Addr *)        farCalloc(num_fixups,    sizeof(Addr));
  1321.  
  1322.   /* Initialise the text hash table, first the "spine" then the hash values */  
  1323.   textHash =    (Text **)        farCalloc(texthsz,      sizeof(Text *));
  1324.   for(i=0;i<texthsz;++i)
  1325.      textHash[i] = (Text *)        farCalloc(NUM_TEXTH,    sizeof(Text));
  1326.   savedText = num_text;
  1327.   
  1328.   /* Initialise the type arrays */
  1329.   Dynamic_Type_Init();
  1330. }
  1331. #endif
  1332.  
  1333.  
  1334. /*-------------------------------------------------------------------------*/
  1335.